Skunkware 5/Skunkware 5.iso/tls/tls074c.sunsparc.Z/tls074c.sunsparc/lib/vtcl/examples/callbacks.tcl

Text File | 1995-07-20 | 4.5 KB | 180 lines

#!/bin/vtcl
# ---------------------------------------------------------------------
# Copyright 1994 by SCO, Inc.
# Permission to use, copy, modify, distribute, and sell this software
# and its documentation for any purpose is hereby granted without fee,
# provided that the above copyright notice appear in all copies and that
# both that copyright  notice  and  this  permission  notice  appear  in
# supporting documentation, and that the name  of  SCO  not  be used  in
# advertising or publicity pertaining  to distribution of  the  software
# without   specific,   written  prior   permission.    SCO   makes   no
# representations  about  the  suitability  of  this  software  for  any
# purpose.  It is provided "as is" without express or implied warranty.
# ---------------------------------------------------------------------
#
# Demo        : callbacks.tcl
# Description    : This program simply shows the kind of information,
# Comments    : associated with individual widgets, that is passed
#        : to a callback function.
# Highlights    - Use of rowcolumn widget for placing an assortment of
#          widgets on a form.
#         - Check out the use of "-xmArgs" to affect the foreground
#          color the labels in the callback form.
#

proc QuitProgramCB {cbs} {
    # You can put multiple commands on the same line using ';'
    VtClose; exit 0
}


# This callback displays the information stored in the keyed list
# that is passed as a parameter ("cbs").  Two rowcolumn widgets are
# placed side-by-side to organize the label widgets in this form.
#
proc GenericCB {widget cbs} {
    VtLock
    global dlog
    set postDlog [VtFormDialog $dlog.${widget}Dlog \
    -title "$widget Callback Output" \
    -okCallback VxEndFormCB \
    -wmDecoration ALL \
    -allowDuplicateName \
    ]
    set titleLblW [VtLabel $postDlog.titleLblW \
        -label "Command:" \
        -font medNormalFont \
        ]
    set nameLblW [VtLabel $postDlog.nameLblW \
        -label "$widget" \
        -font medItalicFont \
        -leftSide $titleLblW \
        -alignTop $titleLblW \
        ]
    set sepW [VtSeparator $postDlog.sepW \
        -topSide $nameLblW \
        -rightSide FORM \
        -rightOffset 0 \
        -leftOffset 0 \
        ]
    set keyRowC [VtRowColumn $postDlog.keyRowC\
        -topSide $sepW\
        -numColumns 1 \
        -topOffset 0 \
        ]
    set valueRowC [VtRowColumn $postDlog.valueRowC\
        -leftSide  $keyRowC \
        -alignTop  $keyRowC \
        -topOffset 0 \
        -leftOffset 0 \
        -rightSide  FORM \
        -numColumns 1 \
        ]
    set keyLblW [VtLabel $keyRowC.keyLblW \
        -label "Key" \
        -labelCenter \
        -font smallBoldFont \
        ]
    set valueLblW [VtLabel $valueRowC.valueLblW \
        -label "Value" \
        -labelCenter \
        -font smallBoldFont \
        ]
    foreach key [keylkeys cbs] {
        VtLabel $keyRowC.$key -label "$key :" -labelRight \
            -xmArgs "XmNforeground red"
        VtLabel $valueRowC.$key -label [keylget cbs $key]
    }
    VtShow $postDlog
    VtUnLock

}

# Make connection with the display engine
#
set appShell [VtOpen decor]

set dlog [VtFormDialog $appShell.form \
    -title "Demo: Callbacks" \
    -wmDecoration ALL \
    -wmCloseCallback QuitProgramCB \
    ]

set labelW [VtLabel $dlog.label \
    -label "Select a widget to see the associated\ncallback information" \
    -font medBoldFont \
    -rightSide FORM \
    ]

# here's the rowcolumn manager widget that we'll use to arrange
# the different widgets into two columns.
set rowColumnW [VtRowColumn $dlog.rowcol\
    -topSide $labelW\
    -rightSide  FORM \
    -packing TIGHT \
    ]

set pushB [VtPushButton $rowColumnW.pushB \
    -callback "GenericCB VtPushButton" \
    -label "Push Me" \
    -labelCenter \
    ]

set rboxW [VtRadioBox $rowColumnW.rboxW \
    -callback "GenericCB VtRadioBox" \
    ]
set tog1W [VtToggleButton $rboxW.red \
    -label "Red" \
    ]
set tog2W [VtToggleButton $rboxW.blue \
    -label "Blue" \
    ]
set tog3W [VtToggleButton $rboxW.green \
    -label "Green" \
    ]

set listW [VtList $rowColumnW.listW \
    -callback "GenericCB VtList" \
    -itemList [list ScareCrow TinMan Dorothy Toto] \
    -rows 2 \
    -selection EXTENDED \
    ]

set scaleW [VtScale $rowColumnW.scaleW \
    -callback "GenericCB VtScale" \
    -min 0 \
    -max 100 \
    -showValue True \
    -title "Scale Range of Values:" \
    ]

set cboxW [VtCheckBox $rowColumnW.cboxW \
    -callback "GenericCB VtCheckBox" \
    ]
set tog1W [VtToggleButton $cboxW.socks \
    -label "socks" \
    ]
set tog2W [VtToggleButton $cboxW.shirts \
    -label "shirts" \
    ]
set tog3W [VtToggleButton $cboxW.shoes \
    -label "shoes" \
    ]

set textW [VtText $rowColumnW.textW \
    -callback "GenericCB VtText" \
    -value "Enter something..." \
    -rows 1 \
    ]

VtPushButton $dlog.quitPushB \
    -label "Quit" \
    -labelCenter \
    -font medBoldFont \
    -rightSide FORM  \
    -bottomSide FORM  \
    -callback QuitProgramCB

VtShow $dlog
VtMainLoop